PC Professionell 2005 June/PCpro_2005_06.ISO/files/opensource/amc/amc_install.exe/{app}/Scripts/MrCinemaCinefilCommon.pas

Pascal/Delphi Source File | 2005-02-17 | 16.1 KB | 393 lines

unit MrCinemaCinefilCommon;
(***************************************************
partie commune aux scripts MrCinema et Cinefil
nΘcessite les modules StringUtils7552.pas et StringUtils1.pas
version 1.0
***************************************************)

uses
    StringUtils7552;

const
    cinefil_id = 0;                                                // identifiants
    mrcinema_id = 1;
//
    CinefilBase = 'http://www.cinefil.com';
    CinefilUrl  = CinefilBase + '/cinefil2005/';
{ recherche: les films sont triΘs par annΘe (dΘcroissante)}
    CinefilUrlLook = CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=';

var
// note FormatUTF8 est dΘclarΘ dans StringUtils7552 (integer)
    filmok, debug: Boolean;
     MovieName, firstcall, abort, batchlogfic, debugrep, msgano: string;
    batchlog, confbatch: TstringList;
    calledBy, BatchMode, FormatTitre: integer;
    bestpoids, maxcount, pagemax: Integer;
    PageNext, PagePrev, bestadr, besttxt, lookreal, lookmovie, looktxt: String;

//------------------------------------------------------------------------------
// recherche du film (cinΘfil)
// MovieName = nom du film cherchΘ (tel que saisi, cad non formatΘ)
//------------------------------------------------------------------------------
procedure AnalyzePageCinefil;
var
    Address, Page, Line, Value, PageFilm, urlfilm: string;
    pagenum, i: integer;
    memo: TStringList;

begin
    pagenum := 0;                                             // compteur de pages
// init adresse 1Φre recherche
    Address := CinefilUrlLook+FormatMovieName3(MovieName);
    repeat
// traitement page courante
    PageNext := '';
    PagePrev := '';
    pagenum := pagenum + 1;
    FormatUTF8 := 1;
    memoAdr := TStringList.Create;                           // init liste de mΘmo
    memoTxt := TStringList.Create;
    Page := GetPage(UrlEncode(Address));
    if debug then
        DumpPage(debugrep+'choixCinefil'+IntToStr(pagenum)+'.txt', Page);    // debug
    Page := TextAfter(Page, '<B> Résultat ');     // infos utiles
    if Page = '' then
    begin
        LogMessage('CinΘfil: erreur lecture page de recherche '+IntToStr(pagenum)); // non trouvΘ = erreur
        memoAdr.Free;
        memoTxt.Free;
        exit;
    end;
// recherche pages prΘcΘdente et suivante
    Line := TextBefore(Page, '</TD>', '');            // Line = url's << < page1 page2 ... > >>
    Page := RemainingText;
    if Pos('HREF', AnsiUpperCase(Line)) = 0 then Line := '';           // 1 seule page
    while Line <> '' do
    begin
        Value := TextBefore(Line, '/a>', '');            // Value = url page xxx
        Delete(Line, 1, Pos('</a>', Line)+4);            // Line = les suivantes
// ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et >
        if Pos('><<<', Value) > 0 then continue;
        if Pos('>>><', Value) > 0 then continue;
        if Pos('><<', Value) > 0 then
        begin                                           // Value = url page prΘcΘdente
            PagePrev := GetUrl(Value, '', CinefilBase);
            memoAdr.Add(PagePrev);
            memoTxt.Add('<<< page prΘcΘdente');
        end;
        if Pos('>><', Value) > 0 then
            PageNext := GetUrl(Value, '', CinefilBase);   // Value = url page suivante
    end;  {while line <> ''}
// mΘmo des films de cette page
    urlfilm := 'HREF=''../fichefilm.cfm?ref=';
    memo := TStringList.Create;
    memo.Text := StringReplace(Page, '</TR>', crlf);  // separe lignes
    for i := 0 to memo.Count-1 do
    begin
    Line := memo.GetString(i);
    PageFilm := GetUrl(Line, urlfilm, CinefilUrl);
    if PageFilm = '' then continue;     // pas d'url = autre chose ou ligne vide
    memoAdr.Add(PageFilm);
// sΘparer le rΘalisateur du reste avant HTMLRemoveTags
    Line := StringReplace(Line, '</a>', sepchar1);  // aprΦs le titre
    memoTxt.Add(FormatText(Line));  // [annΘe] nom du film sepchar1 de rΘalisateur
    end;         {for i}
    memo.Free;
    if PageNext <> '' then
    begin
        memoAdr.Add(PageNext);
        memoTxt.Add('>>> page suivante');
    end;
    if memoAdr.Count = 0 then
    begin
        LogMessage('CinΘfil: aucun film trouvΘ pour "'+MovieName+'"');
        memoAdr.Free;
        memoTxt.Free;
        exit;
    end;
    if BatchMode > 0 then
    begin
// mode batch : recherche du meilleur poids pour les films de cette page
        LookBest(cinefil_id);
        if (bestpoids = maxcount) or (PageNext = '') or (pagenum > pagemax) then
// poids max ou pas de page next ou max pages lues: on arrΩte
        begin
            if bestpoids > 0 then                  // on a trouvΘ quelque chose
            begin
                if bestpoids < maxcount then               // infos partielles
                        LogMessage('CinΘfil: '+looktxt+' retenu '+besttxt+' (poids='+IntToStr(bestpoids)+')');
                AnalyzePageFilmCinefil(bestadr);                            // page film
            end else
                LogMessage('CinΘfil: pas de correspondance pour '+looktxt);
            break;               // on sort
        end else
// sinon, on va chercher s'il y a mieux dans pagenext
        Address := PageNext;
    end else
    begin
// mode normal
        Address := SelectMovie('Films (CinΘfil)');
        if Address <> '' then
        begin
            if (Address <> PageNext) and (Address <> PagePrev) then
            begin
                AnalyzePageFilmCinefil(Address);                          // page film
                break;                                                    // on sort
            end;
        end else
            LogMessage('CinΘfil: aucun film sΘlectionnΘ');
    end;
    until (Address = '');
    memoAdr.Free;
    memoTxt.Free;
end;

//------------------------------------------------------------------------------
// analyse de la page du film (CinΘfil)
//------------------------------------------------------------------------------
procedure AnalyzePageFilmCinefil(Address: string);
var
    Page, Table, Value, Value2: string;
    BeginPos: Integer;

begin
    FormatUTF8 := 1;
    Page := GetPage(Address);
    if debug then
        DumpPage(debugrep+'filmCinefil.txt', Page);    // debug
    Page := TextAfter(Page, 'R├⌐f├⌐rence film cinefil');          // vire le dΘbut
    if Page = '' then
    Begin
        LogMessage('CinΘfil: erreur lecture page film');
        exit;
    end;
    filmok := True;                                         // τa y est, c'est bon
    if calledBy = cinefil_id then SetField(fieldURL, Address);
    if CanSetPicture then
    begin
// affiche: test s'il y a un grand format
        Value := TextBetween(Page, 'javascript:ZoomPhoto(''', '''');
        if Value = '' then                    // sinon test s'il y a un petit format
            Value := TextBetween(Page, '<IMG class=photo SRC=''', '''');
        if Value <> '' then
            GetPicture(Value)
        else
        begin
            if (calledBy <> cinefil_id) then
            begin
                Value := 'CinΘfil: pas d''affiche prΘvue pour "'+MovieName+'"';
                if BatchMode > 0 then
                    LogMessage(Value)
                else
                    ShowInformation(Value);
            end;
        end;
    end;       {CanSetPicture}
    if calledBy = mrcinema_id then exit;           // MrCinΘma: affiche uniquement
// pays annΘe et durΘe
    Value := TextBetween(Page, '<font class="smallnoir">', '<BR>');
    Page := RemainingText;
    Value := StringReplace(Value, '- ', sepchar1);     // sΘpare les champs
    Value := FormatText(Value);                             // supprime les tags
    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // pays (plusieurs possibles)
    Value := RemainingText;
    SetField(fieldCountry, Value2);
    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // annΘe
    Value := RemainingText;
    SetField(fieldYear, Value2);
    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // durΘe heuresHminutes
    BeginPos := Pos('H', AnsiUpperCase(Value2));
    Value2 := IntToStr(StrToInt(Left(Value2, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0));
    SetField(fieldLength, Value2);
// titre original ou traduit
    Value := TextBetween(Page, '<font class="noir"><font class="rouge16"><B>', '</B>');
    Page := RemainingText;
    Value := FormatText(Value);
// titre original Θventuel
    Value2 := FormatText(TextBetween(Page, '<BR>Titre original :<font class="smallrouge"> <B>', '</B>'));
    Value2 := TranslateText(Value2, FormatTitre);
    Value := TranslateText(Value, FormatTitre);
    if (Value2 = '') or (Value = Value2) then              // 1er titre = original
    begin
        SetField(fieldOriginalTitle, Value);
        SetField(fieldTranslatedTitle, '');
    end else
    begin                                                  // traduit + original
        Page := RemainingText;
        SetField(fieldOriginalTitle, Value2);
        SetField(fieldTranslatedTitle, Value);
    end;
// catΘgorie et rΘalisateur (un/une catΘgorie de rΘalisateur)
    Value := TextBetween(Page, '<font class="noir"><BR>', '<BR>');
    Page := RemainingText;
    Value2 := FormatText(TextAfter(Value, '<B>'));            // rΘalisateur(s)
    SetField(fieldDirector, Value2);
    Value := FormatText(TextBefore(Value, '<B>', ''));         // un/une catΘgorie(s)
    BeginPos := Pos('UN', AnsiUpperCase(Value));                  // virer l'article
    if BeginPos = 1 then
    begin
        BeginPos := Pos(' ', Value);
        Delete(Value, 1, BeginPos);
    end;
    BeginPos := LastPos('DE', AnsiUpperCase(Value));            // virer 'de'
    if BeginPos > 0 then
        Value := Left(Value, BeginPos -1);
    SetField(fieldCategory, Trim(Value));
// acteurs
    Value := TextBefore(Page, '<TABLE BORDER=0><TR><TD><font class=noir>', '');
    Page := RemainingText;
    Value := FormatText(TextBetween(Value, 'avec', crlf));
    SetField(fieldActors, Value);
// description
    Value := FormatText(TextBefore(Page, '</TABLE>', ''));
    SetField(fieldDescription, Value);
end;

//------------------------------------------------------------------------------
// recherche du film correspondant α lookmovie/lookreal (mode batch)
// mΘmorisation de bestpoids, bestadr et besttxt
//------------------------------------------------------------------------------
procedure LookBest(id: integer);
var
    Value, Address, realisateur, name: string;
    filmnum, poids, i: integer;

begin
// rechercher dans la liste mΘmorisΘe le nom du film/rΘalisateur demandΘ
// attention: memoTxt. dΘjα passΘ dans FormatText donc plus de tags et en ascii
    for filmnum := 0 to memoTxt.Count -1 do
    begin
        Address := memoAdr.GetString(filmnum);
        if (Address = PageNext) or (Address = PagePrev) then continue;     // sauf page prev/next
        Value := memoTxt.GetString(filmnum);
        if id = cinefil_id then
// fiche CinΘfil
        begin                                        // [annΘe] nom du film de rΘalisateur
            name := TextBetween(Value, ']', sepchar1);   // nom du film
            realisateur := RemainingText;                // de rΘalisateur(s)
            realisateur := TextAfter(realisateur, 'de');
        end else
        begin
// fiche MrCinema
        name := TextBefore(Value, sepchar1 , '');  // nom du film
           Value := RemainingText;                    // de rΘalisateur (annΘe facultative)
            realisateur := TextAfter(Value, 'de');     // attention: pas de TextBetween
           Value := TextBefore(realisateur, '(', '');
            if Value <> '' then realisateur := Value;
        end;
        realisateur := FormatRealisateur(realisateur);  // rΘalisateur (peut Ωtre '')
        name := CleanString(name);                      // nom du film
// poids rΘalisateur(s)
// ignorer si poids = 0 et les 2 champs non vides
        poids := CompareWords(lookreal, realisateur);
        if (lookreal = '') or (realisateur = '') or (poids > 0) then
        begin
// + (poids du film)x1000
// on refuse poids(rΘalisateur) = 0 si nom du film approximatif (poids <> 100)
            i := CompareWords(lookmovie, name);
            if (poids > 0) or (i = 100) then poids := poids + (i * 1000);
        end;
        if (poids > 1000) and (poids > bestpoids) then       // rΘsultat des courses
// il faut quand mΩme qu'il y ait au moins 1 mot du titre    !!!
        begin                                                  // courant = meilleur
            bestpoids := poids;
            bestadr := Address;
            besttxt := '"'+StringReplace(memoTxt.GetString(filmnum), sepchar1, '')+'"';
            if bestpoids = maxcount then break;   // exact match: inutile de continuer
        end;
    end;    {for filmnum}
end;

//------------------------------------------------------------------------------
// initialisations pour batch mode (nom+rΘalisateur)
//------------------------------------------------------------------------------
procedure initBatchLook;
begin
    lookreal := GetField(fieldDirector);                // rΘalisateur(s) peut Ωtre ''
    lookmovie := MovieName;                             // nom du film
    looktxt := '"'+lookmovie+'/'+lookreal+'"';          // pour les messages
    lookreal := FormatRealisateur(lookreal);            // formatages
    lookmovie := CleanString(lookmovie);
    bestpoids := 0;                                     // init meilleur poids
    maxcount := 100100;                                 // poids maximum
    pagemax := 2;                                       // lire au maximum 3 pages
    bestadr := '';                                      // mΘmo adresse page trouvΘe
    besttxt := '';                                      // et nom du film/rΘalisateur
end;

//------------------------------------------------------------------------------
// formatage realisateur
//------------------------------------------------------------------------------
function FormatRealisateur(str: string) :string;
begin
    str := CleanString(str);
// supprimer les 'et' pour ne garder que les noms
// ce serait dommage de sΘlectionner une fiche parce qu'il y a seulement 'et' en commun !
    str := StringReplace(str, ' et ', ' ');
    str := StringReplace(str, ' & ', ' ');
    result := str;
end;

//------------------------------------------------------------------------------
// valorisation de msgano (mode normal) ou ajout dans la log (mode batch)
//------------------------------------------------------------------------------
procedure LogMessage(m: string);
begin
    if BatchMode > 0 then
        AddToLog('fiche '+GetField(fieldNumber)+': '+m)
    else
        msgano := m;
end;

//------------------------------------------------------------------------------
// initialisation de la log
//------------------------------------------------------------------------------
procedure initBatchLog;
begin
    batchlog := TStringList.Create;
    batchlog.Add('dΘmarrage mode batch');
    batchlog.Add('poids = xxxyyy avec xxx poids du nom du film et yyy poids du rΘalisateur');
    batchlog.Add('chaque poids = pourcentage du nombre de mots cherchΘs/trouvΘs');
    batchlog.Add('100 = correspondance exacte');
    batchlog.Add(StringOfChar('*',80));
    batchlog.SaveToFile(batchlogfic);
// message pour confirmation
    confbatch := TStringList.Create;
    confbatch.Add('Vous avez sΘlectionnΘ le mode batch:');
    confbatch.Add('Avez-vous sauvegardΘ votre base?');
    confbatch.Add('');
    confbatch.Add('En fin de traitement:');
    confbatch.Add('- consultez le fichier '+batchlogfic+' pour les erreurs/infos');
    confbatch.Add('- les films trouvΘs seront cochΘs, les autres non (pour la sΘlection)');
    confbatch.Add(' (voir: outils/prΘfΘrences/liste des films/cases α cocher)');
    confbatch.Add('');
    confbatch.Add('confirmez votre choix');
end;

//------------------------------------------------------------------------------
// ajoute un message dans la log et sauvegarde sur disque
// (parce que je ne sais pas quand τa finit...)
//------------------------------------------------------------------------------
procedure AddToLog(m: string);
begin
    batchlog.Add(m);
    batchlog.SaveToFile(batchlogfic);
end;

//------------------------------------------------------------------------------
// formatage du nom du film (CinΘfil)
//------------------------------------------------------------------------------
function FormatMovieName3(str: string) :string;
begin
// une petite Θdition avant de formater
    str := StringReplace(str, ' & ', ' et ');
// remplacer les apostrophes, tirets et points par des blancs
    str := StringReplace(str, '''', ' ');
    str := StringReplace(str, '.', ' ');
     str := StringReplace(str, '-', ' ');
    result := FormatMovieName(str);
end;

end.